home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / nghelp.zip / FASTSCR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-02  |  11KB  |  349 lines
  1. {$A+,B-,E+,F-,I+,N-,O-,R-,V-}
  2. {$UNDEF DEBUG}
  3. {$IFDEF DEBUG} {$D+,L+,S+} {$ELSE} {$D-,L-,S-} {$ENDIF}
  4. {$DEFINE USECRT}
  5. Unit FastScr;
  6.  
  7. Interface
  8.  
  9. Uses YNSystem{$IFDEF USECRT},YNCRT{$ENDIF};
  10.  
  11.  
  12. Type BorderTypes               = (NoBrdr,
  13.                                   SpaceBrdr,SingleBrdr,DoubleBrdr,
  14.                                   HorizDoubleVertSingleBrdr,
  15.                                   HorizSingleVertDoubleBrdr,
  16.                                   Hatch1Brdr,Hatch2Brdr,Hatch3Brdr);
  17.  
  18.      Borders                   = (HorizTop, HorizBottom,
  19.                                   VertLeft, VertRight, HorizBorders,
  20.                                   VertBorders, AllBorders);
  21.      BorderParts               = (TL,TR,BL,BR,HT,HB,VR,VL,LC,RC,TC,BC,CC);
  22.      BorderArray               = Array[TL..CC] of Char;
  23.  
  24. Const Black                     = $00;
  25.       Blue                      = $01;
  26.       Green                     = $02;
  27.       Cyan                      = $03;
  28.       Red                       = $04;
  29.       Magenta                   = $05;
  30.       Brown                     = $06;
  31.       LightGray                 = $07;
  32.       DarkGray                  = $08;
  33.       LightBlue                 = $09;
  34.       LightGreen                = $0A;
  35.       LightCyan                 = $0B;
  36.       LightRed                  = $0C;
  37.       LightMagenta              = $0D;
  38.       Yellow                    = $0E;
  39.       White                     = $0F;
  40.       Blink                     = $80;
  41.       BlackBG                   = $00;
  42.       BlueBG                    = $10;
  43.       GreenBG                   = $20;
  44.       CyanBG                    = $30;
  45.       RedBG                     = $40;
  46.       MagentaBG                 = $50;
  47.       BrownBG                   = $60;
  48.       LightGrayBG               = $70;
  49.  
  50.       BorderSt                 : Array [SpaceBrdr..Hatch3Brdr] of
  51.                                   BorderArray=
  52.                                   ('█████████████',
  53.                                    '┌┐└┘──││├┤┬┴┼',
  54.                                    '╔╗╚╝══║║╠╣╦╩╬',
  55.                                    '╒╕╘╛══││╞╡╤╧╪',
  56.                                    '╓╖╙╜──║║╟╢╥╙╫',
  57.                                    '░░░░░░░░░░░░░',
  58.                                    '▒▒▒▒▒▒▒▒▒▒▒▒▒',
  59.                                    '▓▓▓▓▓▓▓▓▓▓▓▓▓');
  60.  
  61.  
  62. Type StrScreen   = String[80];
  63.  
  64.      WindowCoord = Record
  65.       X1,Y1,X2,Y2 : Byte;
  66.      End;
  67.  
  68.      DisplayOBJ  = Object
  69.       vScreenPtr    : Pointer;
  70.       vWindow       : WindowCoord;
  71.       vWindowIgnore : Boolean;
  72.       vWidth        : Byte;
  73.  
  74.       Constructor Init;
  75.       Procedure   FastWrite(X,Y,Attr : Byte;St : StrScreen);
  76.       Procedure   FastPWrite(X,Y : Byte;St : StrScreen);
  77.       Procedure   WriteCenter(Y,Attr : Byte;St : StrScreen);
  78.       Procedure   WriteHi(X,Y,AttrHi,Attr : Byte;St : StrScreen);
  79.       Procedure   ChangeAttr(X,Y,Attr,Len : Byte);
  80.       Function    ReadChar(X,Y : Byte) : Char;
  81.       Function    ReadScreenLn(Y : Byte) : String;
  82.       Procedure   SetWindow(X1,Y1,X2,Y2 : Byte);
  83.       Procedure   TitleEngine(X1,Y1,X2,Y2 : Byte;Title : StrScreen);
  84.       Procedure   BoxEngine(X1,Y1,X2,Y2,Attr : Byte;Bordertype : BorderTypes;
  85.                             Filled : Boolean);
  86.       Function    WhereX : Byte;
  87.       Function    WhereY : Byte;
  88.       Procedure   GotoXY(X,Y : Byte);
  89.       Destructor  Done;
  90.      End;
  91.  
  92.  
  93.  
  94. Var Screen : DisplayOBJ;
  95.  
  96. Implementation
  97.  
  98. (*------ Externals ---------------------------------------------------------*)
  99. {$L FASTSCR.OBJ}
  100. {$F+}
  101. Procedure AsmWrite(Var ScrPtr;Wid,Col,Row,Attr : Byte;St : String); External;
  102. Procedure AsmPWrite(Var ScrPtr;Wid,Col,Row : Byte;St : String);     External;
  103. Procedure AsmAttr(Var ScrPtr;Wid,Col,Row,Attr,Len : Byte);          External;
  104. Procedure AsmMoveFromScreen(Var Source,Dest;Length : Word);         External;
  105. Procedure AsmMoveToScreen(Var Source,Dest;Length : Word);           External;
  106. {$F-}
  107. (*--------------------------------------------------------------------------*)
  108.  
  109. Function Duplicate(Ch : Char;Times : Byte) : String;
  110. Var F : String;
  111. Begin
  112.  FillChar(F,Times+1,Ch);
  113.  Byte(F[0]) := Times;
  114.  Duplicate := F;
  115. End;
  116.  
  117. (*--------------------------------------------------------------------------*)
  118.  
  119. Procedure FillWord(Var Dest;Width,Value : Word);
  120. Begin
  121.  if CheckSnow then
  122.   Inline($C4/$BE/Dest/            {         LES     DI,Dest[BP]       }
  123.          $8B/$8E/Width/           {         MOV     CX,Width[BP]      }
  124.          $8B/$9E/Value/           {         MOV     BX,Value[BP]      }
  125.          $FC/                     {         CLD                       }
  126.          $E3/$16/                 {         JCXZ    READY             }
  127.          $BA/$03DA/               {         MOV     DX,3DAH           }
  128.          $B4/$09/                 {         MOV     AH,9              }
  129.          $EC/                     { TEST1:  IN      AL,DX             }
  130.          $D0/$D8/                 {         RCR     AL,1              }
  131.          $72/$FB/                 {         JB      TEST1             }
  132.          $FA/                     {         CLI                       }
  133.          $EC/                     { TEST2:  IN      AL,DX             }
  134.          $22/$C4/                 {         AND     AL,AH             }
  135.          $74/$FB/                 {         JZ      TEST2             }
  136.          $8B/$C3/                 {         MOV     AX,BX             }
  137.          $AB/                     {         STOSW                     }
  138.          $FB/                     {         STI                       }
  139.          $E2/$EF) Else            {         LOOP    TEST1             }
  140.                                   { READY:                            }
  141.   Inline($C4/$BE/Dest/            {         LES     DI,Dest[BP]       }
  142.          $8B/$8E/Width/           {         MOV     CX,Width[BP]      }
  143.          $8B/$86/Value/           {         MOV     AX,Value[BP]      }
  144.          $FC/                     {         CLD                       }
  145.          $F3/$AB);                {         REP     STOSW             }
  146. End;
  147.  
  148.  
  149. Constructor DisplayOBJ.Init;
  150. Begin
  151.  vScreenPtr    := VideoPtr;
  152.  vWidth        := MaxCols;
  153.  vWindowIgnore := False;
  154.  
  155.  vWindow.X1 := 1;
  156.  vWindow.Y1 := 1;
  157.  vWindow.X2 := MaxCols;
  158.  vWindow.Y2 := MaxRows;
  159. End;
  160.  
  161. Procedure DisplayOBJ.FastWrite(X,Y,Attr : Byte;St : StrScreen);
  162. Begin
  163.  if vWindowIgnore then
  164.   AsmWrite(vScreenPtr^,vWidth,X,Y,Attr,St)
  165.   Else Begin
  166.         St := Copy(St,1,vWindow.X2-Pred(X)-Pred(vWindow.X1));
  167.         if Y+Pred(vWindow.Y1) <= vWindow.Y2 then
  168.         AsmWrite(vScreenPtr^,vWidth,Pred(vWindow.X1)+X,Pred(vWindow.Y1)+Y,
  169.                  Attr,St);
  170.        End;
  171. End;
  172.  
  173. Procedure DisplayOBJ.FastPWrite(X,Y : Byte;St : StrScreen);
  174. Begin
  175.  if vWindowIgnore then
  176.   ASMPWrite(vScreenPtr^,vWidth,X,Y,St)
  177.   Else Begin
  178.         St := Copy(St,1,vWindow.X2-Pred(X)-Pred(vWindow.X1));
  179.         if Y+Pred(vWindow.Y1) <= vWindow.Y2 then
  180.         ASMPWrite(vScreenPtr^,vWidth,Pred(vWindow.X1)+X,Pred(vWindow.Y1)+Y,St);
  181.        End;
  182. End;
  183.  
  184. Procedure DisplayOBJ.WriteCenter(Y,Attr : Byte;St : StrScreen);
  185. Var X : Integer;
  186. Begin
  187.  if vWindowIgnore then
  188.   Begin
  189.    X :=  (MaxCols - Length(St)) Div 2;
  190.    if X < 1 then X := 1;
  191.   End Else Begin
  192.             X := (Succ(vWindow.X2-vWindow.X1) - Length(St)) Div 2;
  193.            End;
  194.  FastWrite(X,Y,Attr,St);
  195. End;
  196.  
  197. Procedure DisplayOBJ.WriteHi(X,Y,AttrHi,Attr : Byte;St : StrScreen);
  198. Const HiMarker = '~';
  199.  
  200. Var P  : Byte;
  201.     Hi : Boolean;
  202.  
  203.   Procedure WriteBit(St : StrScreen);
  204.   Begin
  205.    if Hi then FastWrite(X,Y,AttrHi,St)
  206.     Else FastWrite(X,Y,Attr,St);
  207.   End;
  208.  
  209. Begin
  210.  Hi := False;
  211.  P := Pos(HiMarker,St);
  212.  While P <> 0 do
  213.   Begin
  214.    if P > 1 then
  215.    WriteBit(Copy(St,1,pred(P)));
  216.    Delete(St,1,P);
  217.    Inc(X,Pred(P));
  218.    P := Pos(HiMarker,St);
  219.    Hi := Not Hi;
  220.   End;
  221.  WriteBit(St);
  222. End;
  223.  
  224.  
  225. Procedure DisplayOBJ.ChangeAttr(X,Y,Attr,Len : Byte);
  226. Begin
  227.  if vWindowIgnore then
  228.   ASMAttr(vScreenPtr^,vWidth,X,Y,Attr,Len)
  229.   Else Begin
  230.         Inc(X,Pred(vWindow.X1));
  231.         Inc(Y,Pred(vWindow.Y1));
  232.